Last Update: April 8, 2019
This report presents data on local and statewide Housing Choice Voucher (HCV) usage to better understand where source of income discrimination may be occurring and support related advocacy efforts.
This report was built using open-source programming, tools and datasets, including R, QGIS, GitHub.
All datasets used in this report are publicly-available and from administrative sources.
# Import Housing Choice Voucher Data
hcv <- read.csv("data/HUDPicture_2017_HCV.csv", stringsAsFactors = FALSE) %>%
filter(Id2 != "42XXX999999") %>%
mutate(tract = Id2) %>%
mutate(county = str_sub(tract, 1, 5)) %>%
select(tract, county, hcv_sub_units)
tenure <- read.csv("data/ACS_17_5YR_B25003_with_ann_TENURE.csv", stringsAsFactors = FALSE, colClasses=c("Id2"="character")) %>%
mutate(tract = Id2) %>%
select(-Id, -Id2)
hcv <- hcv %>%
left_join(tenure, by = "tract") %>%
mutate(hcv_rate = ifelse(tothh < 10, NA, 100 * hcv_sub_units/tothh))
hcv.county <- hcv %>%
group_by(county) %>%
summarise(hcv_sub_units = sum(hcv_sub_units, na.rm = TRUE),
tothh = sum(tothh, na.rm = TRUE)) %>%
as.data.frame() %>%
mutate(hcv_rate = 100 * hcv_sub_units/tothh)
# Import Census Data
hisp <- read.csv("data/ACS_17_5YR_B03002_with_ann_HISP.csv", stringsAsFactors = FALSE)
pov <- read.csv("data/ACS_17_5YR_S1701_with_ann_POV.csv", stringsAsFactors = FALSE)
rent <- read.csv("data/ACS_17_5YR_B25064_with_ann_RENT.csv", stringsAsFactors = FALSE)
rent.zcta <- read.csv("data/ZCTA_ACS_17_5YR_B25064_with_ann_RENT.csv", stringsAsFactors = FALSE)
hisp <- hisp %>%
mutate(tract = as.character(Id2)) %>%
mutate(tract_poc = totpop - nhisp_wh) %>%
mutate(tract_pct_poc = 100*(totpop - nhisp_wh)/totpop) %>%
select(tract, totpop, tract_poc, tract_pct_poc)
pov <- pov %>%
mutate(tract = as.character(Id2)) %>%
mutate(tract_pct_pov = 100 * (belpov/totpovstatus)) %>%
select(tract, totpovstatus, belpov, tract_pct_pov)
rent <- rent %>%
mutate(high_moe = ifelse(moe_median_rent/median_rent > 0.40, 1, 0)) %>%
mutate(tract = as.character(GEOID))
rent.zcta <- rent.zcta %>%
mutate(high_moe = ifelse(moe_median_rent/median_rent > 0.40, 1, 0)) %>%
mutate(zcta = as.integer(GEOID))
# Import Tract Shapefile for Pennsylvania
tracts <- st_read("shps/tl_2018_42_tract.shp", layer = "tl_2018_42_tract", stringsAsFactors = FALSE) %>%
mutate(tract = GEOID) %>%
select(tract, geometry)
# Import County Shapefile
counties <- st_read("shps/PA_Counties.shp", layer = "PA_Counties", stringsAsFactors = FALSE) %>%
mutate(state = str_sub(GEOID, 1, 2)) %>%
filter(state == "42") %>%
mutate(county = GEOID) %>%
select(county, geometry, NAME)
# Join data to tracts and counties
tracts <- left_join(tracts, hcv, by = "tract")
tracts[, 3:7][is.na(tracts[, 3:7])] <- 0 # Replace NAs with 0s
tracts <- tracts %>%
mutate(county = str_sub(tract, 1, 5)) %>%
left_join(hisp, by = "tract") %>%
left_join(pov, by = "tract") %>%
mutate(recap = ifelse(tract_pct_poc>=50 & tract_pct_pov >= 40, "RECAP", "NOT RECAP")) # RECAP definition by HUD: https://data.world/hud/recap
counties <- left_join(counties, hcv.county, by = "county")
# Import HUD Small Area FMRs and Zip Codes
safmr <- read.csv("data/hud_phila_small_fmrs_fy2019.csv", stringsAsFactors = FALSE) %>%
mutate(zcta = zip)
fmr <- read.csv("data/hud_phila_fmrs_fy2015.csv", stringsAsFactors = FALSE) #https://www.huduser.gov/portal/datasets/fmr/fmrs/FY2015_code/2015summary.odn
zcta <- st_read("shps/Phila_ZCTA_WGS84.shp", layer = "Phila_ZCTA_WGS84", stringsAsFactors = FALSE)
This section uses 2017 data from HUD to show the spatial distribution of households with vouchers, both state-wide and locally in Philadelphia.
county.tbl <- counties
st_geometry(county.tbl) <- NULL
county.tbl <- county.tbl %>%
mutate(hcv = round(hcv_sub_units),
hh = round(tothh),
hcv_rate = round(hcv_rate,2)) %>%
select(NAME, hcv, hh, hcv_rate)
datatable(county.tbl, rownames = FALSE, colnames = c("County", "HCV", "Households", "HCV per 100 Households"),
options = list(order = list(list(1, 'desc'))))
The following is a dot density map of voucher holders across Pennsylvania. Each dot represents 10 households with vouchers and is randomly placed within it’s respective Census tract (the dots do not represent the exact location of households). Click on each county to see the number and percentage of voucher holders.
dots <- suppressMessages(st_sample(tracts, size = round(tracts$hcv_sub_units/10), type = "random")) # each dot = 10 hcv units
popup <- paste0("County: ", counties$NAME, "<br>", "Voucher Rate: ", round(counties$hcv_rate, 2), "<br>", "Vouchers: ", counties$hcv_sub_units)
m <- leaflet(options = leafletOptions(preferCanvas = TRUE)) %>%
addProviderTiles("Esri.WorldGrayCanvas", options = providerTileOptions(
updateWhenZooming = FALSE, # map won't update tiles until zoom is done
updateWhenIdle = TRUE # map won't load new tiles when panning
)) %>%
addCircleMarkers(data = dots, weight = 0, color = "#18BC9B", radius = 3) %>%
addPolygons(data = counties, fill = FALSE, stroke = TRUE, color = "#626468", weight = 1, popup = ~popup) %>%
addLegend("bottomright", colors= "#18BC9B", labels="1 dot = 10 HCVs", title="Vouchers in PA Counties")
m
Map of tract-level voucher use across Pennsylvania
tracts <- tracts %>%
filter(hcv_rate < 100.1)
bins <- quantile(tracts$hcv_rate, seq(0,1, by = 1/5), na.rm = TRUE)
pal <- colorBin("YlOrRd", domain = tracts$hcv_rate, bins = bins)
popup <- paste0("Voucher Rate: ", round(tracts$hcv_rate, 2), "<br>",
"Vouchers: ", round(tracts$hcv_sub_units, 0))
m1 <- leaflet(tracts) %>%
addProviderTiles("Esri.WorldGrayCanvas", group = "Base") %>%
addPolygons(stroke = FALSE,
fillColor = ~pal(hcv_rate),
weight = 1, opacity = 0.5,
fillOpacity = 0.5, smoothFactor = 0.5,
popup = ~popup,
highlightOptions = highlightOptions(color = "#444444", weight = 2)) %>%
addPolygons(data = counties, fill = FALSE, stroke = TRUE, color = "#626468", weight = 1) %>%
addLegend(pal = pal,
values = ~hcv_rate,
opacity = 0.7, title = "Voucher Holders </br> per 100 Households", position = "bottomright")
m1